Collection of Tools & Utilities/Collection of Tools and Utilities.iso/turbovis/hsys12.zip/EXAMPLE.ZIP/EXAPLE.PAS

Pascal/Delphi Source File | 1993-08-20 | 7KB | 252 lines

program exaple;

uses objects, drivers, views, menus, app, dialogs, helpfile, msgbox,

     example;

Type
{  ******************************************************************  }
{  ******************************************************************  }
{  Dialog                                                              }
{  ******************************************************************  }
{  ******************************************************************  }

     pmyapp = ^tmyapp;
     TMyApp = object(TApplication)
       myhelpwin : phelpwindow;
       constructor init;
       procedure   InitStatusLine; virtual;
       procedure   handleEvent( Var Event: TEvent ); virtual;
       procedure   GetEvent(VAR Event : TEvent ); virtual;
     end;

Const cmakey       = 100;
      cmhindexcall = 101;

Var MyApp        : TMyApp;
    overridehelp : word;


{  ******************************************************************  }
{  ******************************************************************  }
{  Application  }
{  ******************************************************************  }
{  ******************************************************************  }
constructor tmyapp.init;
Var R  : TRect;
    sc : word;
begin
  inherited init;

  GetExtent ( R );
  R.B.Y := R.A.Y + 1;
  MenuBar := pmenubar(New ( pMenuBar, Init ( R, NewMenu (
    NewSubMenu ( '~A Menu~',hcmenu,
    NewMenu (
      NewItem ( 'A Menutitem ~1~',  '', kbNoKey,  cmakey,   hcmenu,
      NewItem ( 'A Menutitem ~1~',  '', kbNoKey,  cmakey,   hcmenu,
      NewItem ( 'A Menutitem ~1~',  '', kbNoKey,  cmakey,   hcmenu,
      NewItem ( 'A Menutitem ~1~',  '', kbNoKey,  cmakey,   hcmenu,
      NewItem ( 'A Menutitem ~1~',  '', kbNoKey,  cmakey,   hcmenu,
     nil)))))),
    nil)))));
  Insert(Menubar);
end;


Procedure Tmyapp.InitStatusLine;
Var R : TRect;
    p : pstatusitem;
    q : pstatusdef;

  procedure stndhelp;
  begin
    p:=NewStatusKey('~F1~ Help', kbF1, cmhelp,p);
  end;

Begin
  GetExtent ( R );
  R.A.Y := R.B.Y - 1;
  q:=nil;

{defaulthelp, zuerst: }
  p:=nil;
  p:=NewStatusKey('',                         kbF10,       cmMenu,p);
  p:=NewStatusKey('',                         kbshiftf1,   cmhindexcall,p);
  p:=NewStatusKey('',                         kbf1,        cmhelp,p);
  p:=NewStatusKey('',                         kbctrlf5,    cmresize,p);
  p:=NewStatusKey('',                         kbf5,        cmzoom,p);
  p:=NewStatusKey('',                         kbf6,        cmnext,p);
  p:=NewStatusKey('',                         kbshiftf6,   cmprev,p);
  p:=NewStatusKey('~Alt+X~ Exit',             kbAltX,      cmQuit,p);
  q:=NewStatusDef(0,$FFFF,p,q);

  StatusLine := New(PStatusLine, Init(R,q));
  Insert(statusline);

  registerhelpfile;
end;

procedure tmyapp.handleEvent;
Const exdate = 9;
Var tmp : pointer;
begin
  inherited HandleEvent(Event);

  if (event.what=evcommand) then begin
    clearevent(event);
  end;
end;

procedure tmyapp.GetEvent;
var   W         : PHelpWindow;
      HFile     : PHelpFile;
      HelpStrm  : PDosStream;
      helpfound : PHelpWindow;
      hlpctx    : word;

      modal     : boolean;


Const nonmodal      : boolean = false;
      helpopenerror : boolean = false;

  function isdialoghelp:boolean;
  begin
    isdialoghelp:=(hlpctx>hc0firstcounterend) or (hlpctx<1);
  end;

  procedure openhelpstream;
  begin
    w:=nil;
{ you should use your helpfilename here... }
    HelpStrm := New(PDosStream, Init('example.hlp',stOpenRead));
    if (HelpStrm^.Status<>stOk) then begin
{ help not found or not opend }
      MessageBox(^c'Unable to open help', nil, mfError+mfOkButton);
      ClearEvent(Event);
      helpopenerror:=true;
      exit;
    end;
    HFile:=New(PHelpFile, Init(HelpStrm));
{ will be nil, if not REGISTERHELPFILE }
    if (hfile<>nil) and (not hfile^.modified) then begin
      W:=New(PHelpWindow,Init(HFile,HlpCtx,isdialoghelp));
      disposestr(w^.title);
      w^.title:=newstr('Demo Help');
     end else begin
{ didn't look like a Turbo Vision help or not REGISTERHELPFILE }
      MessageBox(^c'Not a valid helpfile!', nil, mfError+mfOkButton);
      ClearEvent(Event);
      helpopenerror:=true;
      exit;
    end;
  end;

  procedure callhelp;
  Var deskcalc : byte;

    procedure quickcalcdesktop(p : pview); far;
    begin
      inc(deskcalc);
    end;

    procedure findhelpfile(P: PView); far;
    begin
{ if helpwindow already on desktop: focus and switch to page }
      if (p<>nil) and (p^.Valid(cmClose)) and (typeof(p^)=typeof(thelpwindow)) and
         (phelpwindow(p)=myhelpwin) then begin
        helpfound:=phelpwindow(p);

        phelpwindow(p)^.focus;
        phelpwindow(p)^.phv^.SwitchToTopic(hlpctx);
      end;
    end;

    procedure gotomodalpage(P: PView); far;
    begin
{ if helpwindow already modal on desktop: switch to page }
      if (p<>nil) and {(p^.Valid(cmClose)) and}
         (typeof(p^)=typeof(thelpwindow)) and
         (phelpwindow(p)^.ismodal) then begin
        phelpwindow(p)^.phv^.SwitchToTopic(hlpctx);
      end;
    end;

  begin
    deskcalc:=0;
    desktop^.foreach(@quickcalcdesktop);
{ desktop empty and no helpctx? }
    if (deskcalc=1) and (hlpctx=0) then
      hlpctx:=0{hcmenudesktop};

    if (not nonmodal) and (not isdialoghelp) and (not helpopenerror) then begin { ein Fenster ruft...}
{ non modal }
      helpfound:=nil;
      desktop^.foreach(@findhelpfile);

      if (helpfound=nil) or (helpfound<>myhelpwin) then begin
        openhelpstream;
        if (not helpopenerror) and (ValidView(W)<>nil) then begin
          desktop^.insert(W);
          ClearEvent(Event);
          myhelpwin:=w;
        end;
       end else
        ClearEvent(Event);
     end else begin
{ modal }
      if (not nonmodal) then begin
        nonmodal:=true;

        openhelpstream;
        if (not helpopenerror) and (ValidView(W)<>nil) then begin
          execview(W);
          dispose(w,done);
        end;

        nonmodal:=false;
        ClearEvent(Event);
      end;
    end;
  end;


begin
  inherited GetEvent(Event);

  if (Event.What=evCommand) and (Event.Command = cmHelp) then begin
{ helpwindow open? }
    if (desktop^.current<>nil) and (typeof(desktop^.current^)=typeof(thelpwindow))
{  yes: help about help }
      then hlpctx:=hcabout
     else
{ no: check overridehelp }
      if (overridehelp<>0)
        then hlpctx:=overridehelp
        else begin
{ ok, get help. see Notice 2 }
          if (desktop^.current=nil) and (myapp.current<>menubar)
            then hlpctx:=0
            else hlpctx:=gethelpctx;
      end;
    callhelp;
  end;

{ open helpindex, if help not on desktop }
  if ((Event.What=evkeydown) and (Event.keycode=kbshiftf1)) or
     ((Event.What=evcommand) and (Event.command=cmhindexcall)) then begin
    hlpctx:=hcindexpage;
    callhelp;
  end;
end;


begin
  overridehelp:=0;

  myapp.init;
  myapp.run;
  myapp.done;
end.